Click on an area for more info.
Using data from NYC Health, these layers map out city-wide COVID 19 Rates per 100,000 People in each ZCTA. This map includes weekly rates from July 13 to August 10, 2020. Mouseover of ZCTA shows area name, borough, ZCTA, and case rate as designated by NYC Health.
Using data from the New York Times article “Are New Yorkers Wearing Masks?”, this layer maps out observed mask usage rates by the Times’ reporters between July 27 to July 30, 2020. The additional NYT Obs layers shows observed mask usage rates based on perceived gender. The ZCTAs where the intersections of the Times reporters were used to map out observed mask usage rates and to compare NYC Health data with. Mouseover of the ZCTA shows area name, borough, and intersection of observation as reported by the Times. ZCTAs were found by me.
Link to article: https://www.nytimes.com/2020/08/20/nyregion/nyc-face-masks.html## No trace type specified:
## Based on info supplied, a 'scatter' trace seems appropriate.
## Read more about this trace type -> https://plot.ly/r/reference/#scatter
## No trace type specified:
## Based on info supplied, a 'bar' trace seems appropriate.
## Read more about this trace type -> https://plot.ly/r/reference/#bar
nyc.avg.caserate <- nyc.covid19.mask %>%
select("zip", "date","area", "COVID_CASE_RATE") %>%
dplyr::group_by(zip) %>%
dplyr::arrange(zip, date) %>%
mutate(rate = (COVID_CASE_RATE - lag(COVID_CASE_RATE))/lag(COVID_CASE_RATE)) %>%
summarise(avg_rate = mean(rate, na.rm = TRUE))
## `summarise()` ungrouping output (override with `.groups` argument)
nyc.avg.rate.mask <- left_join(nyt.data, nyc.avg.caserate, by ="zip") %>%
mutate(obs_mask = 1 - obs_mask)
plot_ly(nyc.avg.rate.mask,
x = ~area,
y = ~obs_mask,
type = 'scatter',
mode = 'markers',
name = 'Mask Rate',
visible = T) %>%
add_trace(nyc.avg.rate.mask, y = ~avg_rate, name = 'Avg. Change Rate', visible = T) %>%
layout(
title = 'Observed Mask Rates & COVID 19 Positive Rates by Area',
showlegend = TRUE,
yaxis = list(title = "% of Masks Observed/COVID 19 Positive Rate",tickformat = "%"),
xaxis = list(title = "Area"),
hovermode = 'compare'
)
avg_rate.mask_model <- lm(formula = avg_rate ~ obs_mask, data = nyc.avg.rate.mask)
summary(avg_rate.mask_model)
##
## Call:
## lm(formula = avg_rate ~ obs_mask, data = nyc.avg.rate.mask)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0034172 -0.0009060 -0.0000578 0.0005096 0.0037204
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0121353 0.0009391 12.922 2.11e-08 ***
## obs_mask -0.0094030 0.0030206 -3.113 0.00897 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.002089 on 12 degrees of freedom
## Multiple R-squared: 0.4468, Adjusted R-squared: 0.4007
## F-statistic: 9.69 on 1 and 12 DF, p-value: 0.008972